home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok17.lha / IFFtoImage / Sources / IFFtoImage.mod < prev    next >
Text File  |  1993-08-15  |  5KB  |  141 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.    IFFtoImage.mod
  3.     :Author.     Jochen P. Kupfer
  4.     :Address.    Buchenweg 22, D-4006 Erkrath 2
  5.     :Phone.      02104-40673
  6.     :Shortcut.   [SIGMA]
  7.     :Version.    1.0
  8.     :Date.       3/23/89
  9.     :Copyright.  PD
  10.     :Language.   Modula-2
  11.     :Translator. M2Amiga V 3.2
  12.     :Imports.    LoadIFF.mod [fbs] & LoadBody [fbs]
  13.     :UpDate.     none
  14.     :Contents.   Converts IFF-Brush to ImageData-File.
  15.     :Remark.     Derived from Pit Burkardt's IFFtoCode.mod on Amok # 3.
  16. ---------------------------------------------------------------------------*)
  17. MODULE IFFtoImage;
  18.  
  19. FROM SYSTEM     IMPORT ADR, ADDRESS, SHIFT;
  20. FROM Exec       IMPORT UByte;
  21. FROM Intuition  IMPORT ScreenPtr,WindowPtr,CloseScreen;
  22. FROM Arguments  IMPORT NumArgs,GetArg;
  23. FROM Arts       IMPORT TermProcedure,Assert, CurrentLevel;
  24. FROM IFFLoad    IMPORT ReadILBM,ReadILBMFlags,ReadILBMFlagSet,IFFInfo;
  25. FROM Graphics   IMPORT RastPortPtr,BitMapPtr;
  26. FROM InOut      IMPORT WriteString,WriteLn;
  27. FROM Str        IMPORT Concat;
  28. FROM FileSystem IMPORT Lookup, WriteBytes, Close, File,
  29.                        WriteChar, Response, WriteByteBlock;
  30.  
  31. VAR     MyScreen,
  32.         MyOldScreen     :ScreenPtr;
  33.         MyWindow        :WindowPtr;
  34.         Name            :ARRAY[0..79] OF CHAR;
  35.         length,i        :INTEGER;
  36.         Error           :BOOLEAN;
  37.         BitMaps         :ARRAY[0..5] OF ADDRESS;
  38.         ScLineLength,
  39.         LineLength,
  40.         Plane           :LONGINT;
  41.         Pictheight,
  42.         Pictdepth,
  43.         Pictwidth       :LONGINT;
  44.         AnzEingaben     :INTEGER;
  45.         RP              :RastPortPtr;
  46.         BM              :BitMapPtr;
  47.         myLevel         :INTEGER;
  48.         data            :File;
  49.  
  50. PROCEDURE CleanUp;
  51.  BEGIN
  52.    IF myLevel>=CurrentLevel() THEN
  53.      IF MyScreen#NIL THEN CloseScreen(MyScreen) END;
  54.    END;
  55.  END CleanUp;
  56.  
  57.  
  58. PROCEDURE MovePlaneDat(BitMaps:ARRAY OF ADDRESS;Pictwidth,Pictheight,
  59.                         Pictdepth,ScLineLength:LONGINT);
  60.   VAR   Location       :POINTER TO UByte;
  61.         Plane          :CARDINAL;
  62.         Line,Bs        :LONGINT;
  63.  
  64.   BEGIN  (* of MovePlaneDat *)
  65.  
  66.    FOR Plane := 0 TO Pictdepth-1 DO
  67.      FOR Line := 0 TO Pictheight-1 DO
  68.        FOR Bs := 0 TO Pictwidth-1 BY 2 DO  (* need an even numer of bytes *)
  69.          Location:=ADDRESS(BitMaps[Plane]+ ScLineLength*Line+Bs);
  70.          WriteChar(data,CHAR(Location^));
  71.          Location:=ADDRESS(BitMaps[Plane]+ ScLineLength*Line+Bs+1);
  72.          WriteChar(data,CHAR(Location^));
  73.        END; (*FOR Pictwidth*)
  74.      END; (*FOR Line*)
  75.    END; (*FOR Plane*)
  76.  END MovePlaneDat;
  77.  
  78. TYPE
  79.   BLOCK = RECORD
  80.     CASE :BOOLEAN OF
  81.       | TRUE : l:ARRAY[0..2] OF LONGINT;
  82.       | FALSE: b:ARRAY[0..11] OF UByte;
  83.     END;
  84.   END;
  85.  
  86. VAR
  87.   block    :BLOCK;
  88.  
  89.  
  90. BEGIN (* MAIN *)
  91.   myLevel := CurrentLevel();
  92.   TermProcedure(CleanUp);
  93.   AnzEingaben:=NumArgs();
  94.  
  95.   IF AnzEingaben=0 THEN
  96.     WriteString("Sorry, can't work - no Input!"); WriteLn;WriteLn;
  97.     WriteString("From CLI: Name IFF-file as option."); WriteLn;WriteLn;
  98.     WriteString("From Workbench: <SHIFT>-klick IFF-file,"); WriteLn;
  99.     WriteString("then <SHIFT>-doubleklick IFFtoImage"); WriteLn; WriteLn;
  100.   ELSE
  101.     GetArg(1,Name,length);
  102.     MyOldScreen:=MyScreen;
  103.     IF MyOldScreen<>NIL THEN CloseScreen(MyOldScreen) END;
  104.     Error:=ReadILBM(Name,ReadILBMFlagSet{visible},MyScreen,MyWindow);
  105.     Assert((Error),ADR("Error while lading ILBM-File"));
  106.  
  107.     Pictdepth:=IFFInfo.BMHD.depth;      (* dimensions in pixels *)
  108.     Pictheight:=IFFInfo.BMHD.height;
  109.     Pictwidth:=IFFInfo.BMHD.width;
  110.     LineLength := (Pictwidth+7) DIV 8;(* Zeilenlänge in Bytes, aufgerundet *)
  111.     IF LineLength*8<Pictwidth THEN
  112.       WriteString("(* Brushbreite gegenüber IFF geändert! *)"); WriteLn;
  113.       LineLength:=LineLength+2;
  114.     END;
  115.     ScLineLength:= MyScreen^.width DIV 8;
  116.     RP := ADR(MyScreen^.rastPort);
  117.     BM := RP^.bitMap;
  118.     FOR i:=0 TO Pictdepth-1 DO
  119.       BitMaps[i] := BM^.planes[i];
  120.     END;
  121.  
  122.     Concat(Name,".img");
  123.  
  124.     block.l[0] := Pictwidth;         (* no of pixels per line *)
  125.     block.l[1] := Pictheight;        (* no of lines           *)
  126.     block.l[2] := Pictdepth;         (* no of BitPlanes       *)
  127.  
  128.     Lookup(data,Name,1024,TRUE);
  129.     WriteByteBlock(data,block.b);
  130.     Assert(data.res=done,ADR("coudn't write block.b"));
  131.  
  132.     MovePlaneDat(BitMaps,LineLength,Pictheight,
  133.                          Pictdepth,ScLineLength);
  134.     Close(data);
  135.  
  136.     WriteLn;
  137.     WriteString("Thanks! It was a pleasure to work with you ...");
  138.     WriteLn;
  139.   END; (*IF*)
  140. END IFFtoImage.mod
  141.